SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00003 1 05-25-9408:00ALL BRIAN RICHARDSON Printing A tcollection SWAG9405 31 d πunit BPrint;πinterfaceπuses Objects, Prt; { Prt is included after! }πprocedure PrintCollection(const Port : word; P : PStringCollection); πimplementation πuses MsgBox, Views; πfunction WriteStr(Port : word; Str : String): boolean; πvar x : boolean; π q : word;π i : byte; πbegin π repeat π x := Ready(Port); π if not x then q := MessageBox(^C'Printer not Ready. Try Again?', nil, π mfYesButton + mfNoButton + mfError); π until x or (q = cmNo); π i := 1; π while (Ready(Port)) and (q <> cmNo) and (i <> Length(Str)+1) do begin π x := Ready(Port); π if not x then q := MessageBox(^C'Printer Error! Try Again?', nil, π mfYesButton + mfNoButton + mfError);π if q <> cmNo then π if WriteChar(Port, Str[i]) then Inc(i);π end; π WriteStr := False; π if Ready(Port) and (q <> cmNo) then begin π WriteChar(Port, #13); π WriteChar(Port, #10); π WriteStr := True; π end; πend; π πprocedure PrintCollection(const Port : word; P : PStringCollection);πvar x : integer; π q : word; πbegin π q := MessageBox(^C'To print, ready your printer and Press OK', nil, π mfInformation + mfOkCancel); π if q = cmOk then begin π x := -1; π repeat π inc(x); π until not WriteStr(Port, PString(P^.At(x))^) or (X = P^.Count - 1);π end;ππend;πend.ππ{ ---- CUT HERE -------- }ππunit Prt;πinterface πuses objects; πconst π Lpt1 = 0; Lpt2 = 1; π Lpt3 = 2; lf = #10; π cr = #13; pTimeOut = $01; π pIOError = $08; pNoPaper = $20; π pNotBusy = $80;π pTestAll = pTimeOut + pIOError + pNoPaper; πfunction WriteChar(const APort : word; s : char): boolean; πfunction Ready(const APort : word): boolean; πfunction Status(const APort : word): byte; πprocedure InitPrinter(const APort : word); πimplementation πprocedure InitPrinter(const APort : word); assembler; πasm π mov ah, 1 π mov bx, APortπ int 17h πend;πfunction Status(const APort : word): byte; assembler; πasm π mov ah, 2 { Service 2 - Printer Status } π mov dx, APort { Printer Port } π int 17h { ROM Printer Services } π mov al, ah { Set function value } πend; πfunction Ready(const APort : word): boolean; πbegin π Ready := Status(APort) and pTestAll = $00; πend; πfunction WriteChar(const APort : word; s : char): boolean;πbegin π if Ready(APort) then π asm π mov ah, 0 { Printer Service - Write Char } π mov al, s { Char to write } π mov dx, APort { Printer Port }π int 17h { ROM Printer Services } π mov al, 0 { Set procedure to false } π and ah, 1 { Check for Error } π jnz @End { Jump to end if error } π mov al, 1 { Set procedure to true } π @End:π end; πend;ππend.ππ{ ---------------- CUT HERE --------------------- }π{π Here's a sample test program so you don't have to write one yourselfπ :).π}ππuses BPrint, Prt;π πfunction Int2Str(const i : longint): string; πvar s : string; πbegin π Str(i, s); π Int2Str := s; πend; π πvar x : integer; π q : PStringCollection; πbegin π q := New(PStringCollection, Init(10, 10)); π for x := 0 to 64 do q^.Insert(NewStr(Int2Str(Random(4000)))); π PrintCollection(Lpt1 {Change for your printer}, q); πend. π 2 05-26-9410:58ALL SWAG SUPPORT TEAM INI files in TV/OWL SWAG9405 184 d {$A+,F+,I-,R-,S-,V-}ππunit IniTV; {unit for managing INI files using TurboVision/OWL}ππ{*********************************************}π{* INITV.PAS 1.04 *}π{* Copyright (c) Steve Sneed 1993 *}π{*********************************************}ππ{*πNOTE: This code was quickly adapted from some using Object Professional'sπDoubleList object.π*}ππ{$IFNDEF Ver70}π !! STOP COMPILE: This unit requires BP7 !!π{$ENDIF}ππ{if Object Professional is available, use its string routines}π{.$DEFINE UseOPro}ππinterfaceππusesπ{$IFDEF UseOPro}π OpString,π{$ENDIF}π Objects;ππconstπ EncryptionKey : String[80] = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';π FBufSize = 4096;ππtypeπ PLine = ^TLine;π TLine =π object(TObject)π PL : PString;ππ constructor Init(S : String);π destructor Done; virtual;π procedure Update(S : String);π end;πππ PIni = ^TIni;π TIni =π object(TCollection)π IniName : String;π FBufr : PChar;ππ constructor Init(ALimit, ADelta : Integer;π FN : String;π Sparse, Create : Boolean);π {-Construct our INI file object. if Sparse=True, load only "active"π lines (file is considered read-only.) File always updates onπ changes; use SetFlushMode to control.}π destructor Done; virtual;π {-Destroy object when done}π procedure Reload;π {-Reload the INI file after it may have changed externally}π procedure FlushFile;π {-Force an update of the physical file from the current list}π procedure SetFlushMode(Always : Boolean);π {-Turn off/on auto-updating of file when an item is modified}π procedure SetExitFlushMode(DoIt : Boolean);π {-Turn off/on updating of file when the object is disposed}π function GetProfileString(Title, Group, Default : String) : String;π {-Return string item "Title" in "[Group]", or default if not found}π function GetEncryptedProfileString(Title, Group, Default : String) : String;π {-Same as GetProfileString but decrypts the found string}π function GetProfileBool(Title, Group : String; Default : Boolean) : Boolean;π {-Return boolean item "Title" in "[Group]", or default if not found}π function GetProfileByte(Title, Group : String; Default : Byte) : Byte;π {-Return byte item "Title" in "[Group]", or default if notπ found or Not A Number}π function GetProfileInt(Title, Group : String; Default : Integer) : Integer;π {-Return integer item "Title" in "[Group]", or default if notπ found or NAN}π function GetProfileWord(Title, Group : String; Default : Word) : Word;π {-Return word item "Title" in "[Group]", or default if notπ found or NAN}π function GetProfileLong(Title, Group : String; Default : LongInt) : LongInt;π {-Return longint item "Title" in "[Group]", or default if notπ found or NAN}π function SetProfileString(Title, Group, NewVal : String) : Boolean;π {-Change existing item "Title" in "[Group]" to "NewVal"}π function SetEncryptedProfileString(Title, Group, NewVal : String) : Boolean;π {-Change existing item "Title" in "[Group]" to "NewVal"}π function AddProfileString(Title, Group, NewVal : String) : Boolean;π {-Add new item "Title=NewVal" to "[Group]". Creates [Group] if notπ found or if "Title" = '', else adds "Title=NewVal" as last item inπ [Group]}π function AddEncryptedProfileString(Title, Group, NewVal : String) : Boolean;π {-Same as AddProfileString but encrypts "NewVal" when adding}π function KillProfileItem(Title, Group : String) : Boolean;π {-Completely remove the "Title" entry in "[Group]"}π function KillProfileGroup(Group : String) : Boolean;π {-Kill the entire group "[Group]", including group header}π function EnumGroups(P : PStringCollection; Clr : Boolean) : Boolean;π {-Return P loaded with the names of all groups in the file. Returnsπ false only on error. On return P is in file order rather thanπ sorted order.}π function EnumGroupItems(P : PStringCollection; Group : String; Clr : Boolean) : Boolean;π {-Return P loaded with all items in group [Group]. Returns falseπ if Group not found or error. On return P is in file order ratherπ than sorted order}ππ private {these used internally only}π IniF : Text;π NeedUpd : Boolean;π AlwaysUpd : Boolean;π IsSparse : Boolean;π ExitFlush : Boolean;ππ function GetIniNode(Title, Group : String) : PLine;π function GetLastNodeInGroup(Group : String) : PLine;π function GetProfilePrim(Title, Group : String) : String;π end;ππprocedure SetEncryptionKey(NewKey : String);π {-define the encryption key}ππimplementationππ function NewStr(const S: String): PString;π {-NOTE: The default NewStr returns a nil pointer for empty strings. Thisπ will cause problems, so we define a NewStr that always allocates a ptr.}π varπ P: PString;π beginπ GetMem(P, Length(S) + 1);π P^ := S;π NewStr := P;π end;ππ procedure CleanHexStr(var S : string);π {-handle ASM- and C-style hex notations}π varπ SLen : Byte absolute S;π beginπ while S[SLen] = ' ' doπ Dec(SLen);π if (SLen > 1) and (Upcase(S[SLen]) = 'H') then beginπ Move(S[1], S[2], SLen-1);π S[1] := '$';π endπ else if (SLen > 2) and (S[1] = '0') and (Upcase(S[2]) = 'X') then beginπ Dec(SLen);π Move(S[3], S[2], SLen-1);π S[1] := '$';π end;π end;ππ{$IFNDEF UseOPro}π{-If we're not using OPro, define the string manipulation routines we need.}ππconstπ Digits : Array[0..$F] of Char = '0123456789ABCDEF';ππ function HexB(B : Byte) : string;π {-Return hex string for byte}π beginπ HexB[0] := #2;π HexB[1] := Digits[B shr 4];π HexB[2] := Digits[B and $F];π end;ππ function Trim(S : string) : string;π {-Return a string with leading and trailing white space removed}π varπ I : Word;π SLen : Byte absolute S;π beginπ while (SLen > 0) and (S[SLen] <= ' ') doπ Dec(SLen);ππ I := 1;π while (I <= SLen) and (S[I] <= ' ') doπ Inc(I);π Dec(I);π if I > 0 thenπ Delete(S, 1, I);ππ Trim := S;π end;ππ function StUpcase(S : String) : String;π {-Convert a string to all uppercase. Ignores internationalization issues}π varπ I : Byte;π beginπ for I := 1 to Length(S) doπ S[i] := Upcase(S[i]);π StUpcase := S;π end;π{$ENDIF}ππ function StripBrackets(S : String) : String;π varπ B : Byte absolute S;π beginπ S := Trim(S);π if S[b] = ']' thenπ Dec(B);π if S[1] = '[' then beginπ Move(S[2], S[1], B-1);π Dec(B);π end;π StripBrackets := StUpcase(S);π end;ππ procedure SetEncryptionKey(NewKey : String);π {-Define the encryption key to use}π beginπ EncryptionKey := NewKey;π end;ππ function Crypt(S : String) : String;π {-simple self-reversing xor encryption}π varπ SI, KI : Byte;π T : String;π beginπ T := '';π KI := 1;π for SI := 1 to Length(S) do beginπ T := T + Chr(Byte(S[SI]) xor Byte(EncryptionKey[KI]));π Inc(KI);π if KI > Length(EncryptionKey) thenπ KI := 1;π end;π Crypt := T;π end;ππ function Encrypt(S : String) : String;π {-Convert S to XOR-encrypted string, then "hex-ize"}π varπ T, U : String;π I : Integer;π beginπ U := '';π T := Crypt(S);π for I := 1 to Length(T) doπ U := U + HexB(Byte(T[i]));π Encrypt := U;π end;ππ function Decrypt(S : String) : String;π {-Convert "hex-ized" string to encrypted raw string, and decrypt}π varπ T,U : String;π I,C : Integer;π beginπ T := '';π while S <> '' do beginπ U := '$'+Copy(S, 1, 2);π Delete(S, 1, 2);π Val(U, I, C);π T := T + Char(I);π end;π Decrypt := Crypt(T);π end;ππ{---------------------------------------------------------------------------}ππ constructor TLine.Init(S : String);π beginπ inherited Init;π PL := NewStr(S);π end;ππ destructor TLine.Done;π beginπ DisposeStr(PL);π inherited Done;π end;ππ procedure TLine.Update(S : String);π beginπ DisposeStr(PL);π PL := NewStr(S);π end;ππ{---------------------------------------------------------------------------}ππ constructor TIni.Init(ALimit, ADelta : Integer;π FN : String;π Sparse, Create : Boolean);π varπ P : PLine;π S : String;π beginπ inherited Init(ALimit, ADelta);π GetMem(FBufr, FBufSize);ππ IsSparse := Sparse;π NeedUpd := False;π AlwaysUpd := False;π ExitFlush := False;ππ {load INI file}π IniName := FN;π Assign(IniF, IniName);π SetTextBuf(IniF, FBufr[0], FBufSize);π Reset(IniF);π if IOResult <> 0 then beginπ {file doesn't yet exist; drop out}π if not Create then beginπ Done;π Fail;π endπ else beginπ NeedUpd := True;π Exit;π end;π end;ππ while not EOF(IniF) do beginπ ReadLn(IniF, S);π if IOResult <> 0 then beginπ {read error here means something is wrong; bomb it}π Close(IniF); if IOresult = 0 then ;π Done;π Fail;π end;ππ {add the string to the collection}π S := Trim(S);π if (not(Sparse)) or ((S <> '') and (S[1] <> ';')) then beginπ New(P, Init(S));π if P = nil then beginπ {out of memory, bomb it}π Close(IniF);π if IOResult = 0 then ;π Done;π Fail;π end;π Insert(P);π end;π end;π Close(IniF);π if IOResult = 0 then ;ππ AlwaysUpd := True;π ExitFlush := True;π end;ππ destructor TIni.Done;π beginπ if (NeedUpd) and (ExitFlush) thenπ FlushFile;π FreeMem(FBufr, FBufSize);π inherited Done;π end;ππ procedure TIni.Reload;π varπ P : PLine;π S : String;π beginπ FreeAll;π Assign(IniF, IniName);π SetTextBuf(IniF, FBufr[0], FBufSize);π Reset(IniF);π if IOResult <> 0 thenπ Exit;ππ while not EOF(IniF) do beginπ ReadLn(IniF, S);π if IOResult <> 0 then beginπ {read error here means something is wrong; bomb it}π Close(IniF); if IOresult = 0 then ;π Exit;π end;ππ S := Trim(S);π if (not(IsSparse)) or ((S <> '') and (S[1] <> ';')) then beginπ New(P, Init(S));π if P = nil then beginπ {out of memory, bomb it}π Close(IniF); if IOResult = 0 then ;π Exit;π end;π Insert(P);π end;π end;π Close(IniF);π if IOResult = 0 then ;π end;ππ procedure TIni.SetFlushMode(Always : Boolean);π beginπ AlwaysUpd := Always;π end;ππ procedure TIni.SetExitFlushMode(DoIt : Boolean);π beginπ ExitFlush := DoIt;π end;ππ procedure TIni.FlushFile;π {-Force the INI file to be rewritten}π varπ S : String;π P : PLine;π I : Integer;π beginπ if IsSparse thenπ Exit;ππ Assign(IniF, IniName);π SetTextBuf(IniF, FBufr[0], FBufSize);π Rewrite(IniF);π if IOResult <> 0 thenπ Exit;ππ I := 0;π while I < Count do beginπ P := PLine(At(I));π WriteLn(IniF, P^.PL^);π if IOResult <> 0 then beginπ Close(IniF);π if IOResult = 0 then ;π exit;π end;π Inc(I);π end;ππ Close(IniF);π if IOResult = 0 then ;π NeedUpd := False;π end;ππ function TIni.GetIniNode(Title, Group : String) : PLine;π {-Return the Title node in Group, or nil if not found}π varπ P : PLine;π S : String;π I : Integer;π GroupSeen : Boolean;π beginπ GetIniNode := nil;π if Count = 0 then exit;ππ {fixup strings as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';π Group := StUpcase(Group);π Title := StUpcase(Title);ππ {search}π GroupSeen := False;π I := 0;π while I < Count do beginπ P := PLine(At(I));π if P^.PL^[1] = '[' then beginπ {a group header...}π if StUpcase(P^.PL^) = Group thenπ {in our group}π GroupSeen := Trueπ else if GroupSeen thenπ {exhausted all options in our group; get out}π exit;π endπ else if (GroupSeen) and (P^.PL^[1] <> ';') then beginπ {in our group, see if the title matches}π S := Copy(P^.PL^, 1, Pos('=', P^.PL^)-1);π S := Trim(S);π S := StUpcase(S);π if Title = S then beginπ GetIniNode := P;π exit;π end;π end;π Inc(I);π end;π end;ππ function TIni.GetLastNodeInGroup(Group : String) : PLine;π {-Return the last node in Group, or nil if not found}π varπ P,Q : PLine;π S : String;π I : Integer;π GroupSeen : Boolean;π beginπ GetLastNodeInGroup := nil;π if Count = 0 then exit;ππ {fixup strings as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';π Group := StUpcase(Group);ππ {search}π GroupSeen := False;π Q := nil;π I := 0;π while I < Count do beginπ P := PLine(At(I));π if P^.PL^[1] = '[' then beginπ {a group header...}π if StUpcase(P^.PL^) = Group thenπ {in our group}π GroupSeen := Trueπ else if (GroupSeen) then beginπ {exhausted all lines in our group, return the last pointer}π if Q = nil thenπ Q := PLine(At(I-1));π I := IndexOf(Q);π while (I >= 0) and (PLine(At(I))^.PL^ = '') doπ Dec(I);π if I < 0 thenπ GetLastNodeInGroup := nilπ elseπ GetLastNodeInGroup := PLine(At(I));π exit;π end;π end;π Q := P;π Inc(I);π end;π if GroupSeen thenπ GetLastNodeInGroup := Qπ elseπ GetLastNodeInGroup := nil;π end;ππ function TIni.GetProfilePrim(Title, Group : String) : String;π {-Primitive to return the string at Title in Group}π varπ P : PLine;π S : String;π B : Byte absolute S;π beginπ P := GetIniNode(Title, Group);π if P = nil thenπ GetProfilePrim := ''π else beginπ S := P^.PL^;π S := Copy(S, Pos('=', S)+1, 255);π S := Trim(S);π if (S[1] = '"') and (S[b] = '"') then beginπ Move(S[2], S[1], B-1);π Dec(B, 2);π end;π GetProfilePrim := S;π end;π end;ππ function TIni.KillProfileItem(Title, Group : String) : Boolean;π {-Removes Title item in Group from the list}π varπ P : PLine;π beginπ KillProfileItem := False;π if IsSparse then Exit;ππ P := GetIniNode(Title, Group);π if P <> nil then beginπ Free(P);π KillProfileItem := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π end;π end;ππ function TIni.KillProfileGroup(Group : String) : Boolean;π {-Removes all items in Group from the list}π varπ P : PLine;π I : Integer;π S : String;π beginπ KillProfileGroup := False;π if IsSparse then Exit;ππ {fixup string as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';π Group := StUpcase(Group);ππ {search}π I := 0;π while I < Count do beginπ P := PLine(At(I));π if (P^.PL^[1] = '[') and (StUpcase(P^.PL^) = Group) then beginπ Inc(I);π while (I < Count) and (PLine(At(I))^.PL^[1] <> '[') doπ Free(At(I));π Free(P);π KillProfileGroup := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π Exit;π end;π Inc(I);π end;π end;ππ function TIni.GetProfileString(Title, Group, Default : String) : String;π {-Returns Title item in Group, or Default if not found}π varπ S : String;π beginπ S := GetProfilePrim(Title, Group);π if S = '' thenπ S := Default;π GetProfileString := S;π end;ππ function TIni.GetEncryptedProfileString(Title, Group, Default : String) : String;π {-Returns decrypted Title item in Group, or Default if not found}π varπ S : String;π beginπ S := GetProfilePrim(Title, Group);π if S = '' thenπ S := Defaultπ elseπ S := DeCrypt(S);π GetEncryptedProfileString := S;π end;ππ function TIni.GetProfileBool(Title, Group : String; Default : Boolean) : Boolean;π varπ S : String;π beginπ S := Trim(GetProfilePrim(Title, Group));π if S <> '' then beginπ S := StUpcase(S);π if (S = 'TRUE') or (S = '1') or (S = 'Y') or (S = 'YES') or (S = 'ON') thenπ GetProfileBool := Trueπ else if (S = 'FALSE') or (S = '0') or (S = 'N') or (S = 'NO') or (S = 'OFF') thenπ GetProfileBool := Falseπ elseπ GetProfileBool := Default;π endπ elseπ GetProfileBool := Default;π end;ππ function TIni.GetProfileByte(Title, Group : String; Default : Byte) : Byte;π varπ S : String;π C : Integer;π B : Byte;π beginπ S := Trim(GetProfilePrim(Title, Group));π if S <> '' then beginπ CleanHexStr(S);π Val(S, B, C);π if C = 0 thenπ GetProfileByte := Bπ elseπ GetProfileByte := Default;π endπ elseπ GetProfileByte := Default;π end;ππ function TIni.GetProfileInt(Title, Group : String; Default : Integer) : Integer;π varπ S : String;π I,C : Integer;π beginπ S := Trim(GetProfilePrim(Title, Group));π if S <> '' then beginπ CleanHexStr(S);π Val(S, I, C);π if C = 0 thenπ GetProfileInt := Iπ elseπ GetProfileInt := Default;π endπ elseπ GetProfileInt := Default;π end;ππ function TIni.GetProfileWord(Title, Group : String; Default : Word) : Word;π varπ S : String;π W : Word;π C : Integer;π beginπ S := Trim(GetProfilePrim(Title, Group));π if S <> '' then beginπ CleanHexStr(S);π Val(S, W, C);π if C = 0 thenπ GetProfileWord := Wπ elseπ GetProfileWord := Default;π endπ elseπ GetProfileWord := Default;π end;ππ function TIni.GetProfileLong(Title, Group : String; Default : LongInt) : LongInt;π varπ S : String;π I : LongInt;π C : Integer;π beginπ S := Trim(GetProfilePrim(Title, Group));π if S <> '' then beginπ CleanHexStr(S);π Val(S, I, C);π if C = 0 thenπ GetProfileLong := Iπ elseπ GetProfileLong := Default;π endπ elseπ GetProfileLong := Default;π end;ππ function TIni.SetProfileString(Title, Group, NewVal : String) : Boolean;π varπ S : String;π P : PLine;π beginπ SetProfileString := False;π if IsSparse then exit;ππ P := GetIniNode(Title, Group);π if P = nil thenπ SetProfileString := AddProfileString(Title, Group, NewVal)π else beginπ S := P^.PL^;π System.Delete(S, Pos('=', S)+1, 255);π S := S + NewVal;π P^.Update(S);π SetProfileString := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π end;π end;ππ function TIni.SetEncryptedProfileString(Title, Group, NewVal : String) : Boolean;π varπ S : String;π P : PLine;π beginπ SetEncryptedProfileString := False;π if IsSparse then exit;ππ P := GetIniNode(Title, Group);π if P = nil thenπ SetEncryptedProfileString := AddEncryptedProfileString(Title, Group, NewVal)π else beginπ S := P^.PL^;π System.Delete(S, Pos('=', S)+1, 255);π S := S + EnCrypt(NewVal);π P^.Update(S);π SetEncryptedProfileString := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π end;π end;ππ function TIni.AddProfileString(Title, Group, NewVal : String) : Boolean;π {-add new node and/or group to the list}π varπ P : PLine;π I : Integer;π beginπ AddProfileString := False;π if IsSparse then exit;ππ {fixup strings as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';ππ P := GetLastNodeInGroup(Group);π if P = nil then beginπ {group not found, create a new one}π {add a blank line for spacing}π New(P, Init(''));π if P = nil then Exit;π Insert(P);π New(P, Init(Group));π if P = nil then Exit;π Insert(P);π I := Count;π endπ elseπ I := IndexOf(P)+1;ππ {add our new element after}π if Title = '' thenπ AddProfileString := Trueπ else beginπ New(P, Init(Title+'='+NewVal));π if P <> nil then beginπ AtInsert(I, P);π AddProfileString := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π end;π end;π end;ππ function TIni.AddEncryptedProfileString(Title, Group, NewVal : String) : Boolean;π {-add new encrypted node and/or group to the list}π varπ P,Q : PLine;π I : Integer;π beginπ AddEncryptedProfileString := False;π if IsSparse then exit;ππ {fixup strings as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';ππ P := GetLastNodeInGroup(Group);π if P = nil then beginπ {group not found, create a new one}π {add a blank line for spacing}π New(P, Init(''));π if P = nil then Exit;π Insert(P);π New(P, Init(Group));π if P = nil then Exit;π Insert(P);π I := Count;π endπ elseπ I := IndexOf(P)+1;ππ {add our new element after}π if Title = '' thenπ AddEncryptedProfileString := Trueπ else beginπ New(P, Init(Title+'='+Encrypt(NewVal)));π if P <> nil then beginπ AtInsert(I, P);π AddEncryptedProfileString := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π end;π end;π end;ππ function TIni.EnumGroups(P : PStringCollection; Clr : Boolean) : Boolean;π {-Return P loaded with the names of all groups in the file. Returnsπ false only on error. Uses AtInsert rather than Insert so collectionπ items are in file order rather than sorted order.}π varπ Q : PLine;π R : PString;π I : Integer;π beginπ EnumGroups := False;π if Clr thenπ P^.FreeAll;ππ I := 0;π while I < Count do beginπ Q := PLine(At(I));π if Q^.PL^[1] = '[' then beginπ R := NewStr(StripBrackets(Q^.PL^));π P^.AtInsert(P^.Count, R);π end;π Inc(I);π end;π EnumGroups := True;π end;ππ function TIni.EnumGroupItems(P : PStringCollection; Group : String; Clr : Boolean) : Boolean;π {-Return P loaded with all items in group [Group]. Returns falseπ if Group not found or error. Uses AtInsert rather than Insert soπ collection items are in file order rather than sorted order.}π varπ Q : PLine;π R : PString;π S : String;π I : Integer;π beginπ EnumGroupItems := False;π if Clr thenπ P^.FreeAll;ππ {fixup strings as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';π Group := StUpcase(Group);ππ I := 0;π while I < Count do beginπ Q := PLine(At(I));π if StUpcase(Q^.PL^) = Group then beginπ Inc(I);π while (I < Count) and (PLine(At(I))^.PL^[1] <> '[') do beginπ S := Trim(PLine(At(I))^.PL^);π if (S <> '') and (S[1] <> ';') then beginπ if Pos('=', S) > 0 thenπ S[0] := Char(Pos('=', S)-1);π S := Trim(S);π R := NewStr(S);π P^.AtInsert(P^.Count, R);π end;π Inc(I);π end;π EnumGroupItems := True;π Exit;π end;π Inc(I);π end;π end;ππend.π 3 05-26-9411:04ALL DEVIN COOK TV Library Objects SWAG9405 390 d Unit Misc;ππ{π MISC.PASπ A Turbo Vision Object Libraryππ By Devin Cookπ MSD - 1990ππI haven't been exactly overwhelmed by the amount of Turbo Vision objects sharedπby TP users, so I thought I would thow my hat into the ring and spread a fewπobjects I have developed around.ππI am not an expert in Turbo Vision ( who can be in 3 weeks? ), or in OOP, so Iπhave probably broken quite a few rules, but you might get some ideas from theπwork I have done.ππThis unit has some of the my more mainstream objects included. I have a fewπother, less general objects which I may spread around later.ππThese objects have not been used enough to verify they are 100% bug free, soπif you find any problems, or have any comments, please send me some Emailπ( D.Cook on Genie ).ππ OBJECTS:ππTDateView - A date text box, much like TClockView in TVDemos.ππTPushButton - A descendend of TButton, with "feel" for keyboard users.ππTNum_Box - A number only input box with an adjustable number of digitsπ before and after the decimal point, along with selectableπ negative number acceptance.ππTLinked_Dialog - A descendent of TDialog which allows you to set "Links"π between items ( i.e. item selection through cursor keys ).ππAlso, FormatDate, a function used by TDateView is provided.πππ ╔═════════════╗π ║ TDateView ║π ╚═════════════╝πππTDateView is almost identicle to TClockView ( in TVDemos - Gadget.Pas ).ππINITIALIZATION:ππTDateView is initialized by sending TDateView a TRect giving it's location.ππUSAGE:ππOnce TDateView is initialized, an occasional call to TDateView.Update keepsπthe displayed date current.ππExample:ππ Var TR : TRect ;π DateV : TDateView ;π Beginπ TR.Assign( 60 , 0 , 78 , 1 );π DateV.Init( TR );π DateV.Update ;π End;ππππ ╔═══════════════╗π ║ TPushButton ║π ╚═══════════════╝πππTPushButton is identicle to TButton in every way except that when it isπ"pressed", it actually draws itself pressed.ππThis gives visual feedback to those using non-mouse systems.ππThe delay values in TPushButton.Press may need to be altered to adjust theπ"feel".ππ ╔════════════╗π ║ TNum_Box ║π ╚════════════╝πππTNum_Box is a numerical entry box with definable precision.ππINITIALIZATION:ππTNum_Box is initialized by sending TNum_Box.Init:π Location : TPointπ Max Digits before the decimal point : Integerπ Max Digits after the decimal point : Integerπ Negative Numbers allowed flag : Booleanπ Default Value : ExtendedππIf the digits after the decimal point = 0, no decimal point is displayedπ( or excepted ).ππIf negative numbers are allowed, one extra space is reserved for a negativeπsign. No digits can be entered in this spot.ππOnly Backspace is used to edit the numberical field.ππUSAGE:ππThe value of the input box can be read directly from TNum_Box.Curr_Val.ππThis value may not be up to date if editing is still taking place, or noπdata has been entered. To ensure a correct reading, a call toπTNum_Box.Update_Value is recommended.ππAfter initilization, the box is displayed with blanks for the number of digits.πIf you wish to display the default value instead, use TNum_Box.Update_Value.ππExample:ππ Var TP : TPoint ;π Int_Box1 : TNum_Box ;π Int_Box2 : TNum_Box ;π Flt_Box1 : TNum_Box ;π Beginπ Tp.X := 10 ;π Tp.Y := 5 ;ππ (* Define a box at 10,5 with 3 digits, no decimals, no negatives and aπ default of 0 *)ππ Int_Box1.Init( TP , 3 , 0 , False , 0 )ππ TP.X := 15 ;ππ (* Define a box at 10,15 with 5 digits, no decimals, negatives and aπ default of 1. Then, update the box displaying the default *)ππ Int_Box2.Init( TP , 5 , 0 , True , 1 )π Int_Box2.Update_Value ;ππ TP.X := 25 ;ππ (* Define a box at 10,25 with 5 digits, 2 decimal places , negatives andπ a default of 0. Leave the box a blank. *)ππ flt_Box1.Init( TP , 5 , 2 , True , 0 )ππ End;ππ ╔══════════════════╗π ║ TLinked_Dialog ║π ╚══════════════════╝πππTLinked_Dialog is descendant of TDialog with improved cursor movement betweenπfields.ππDeveloping for a non-mouse system ( even a mouse system ) where your dialogsπhave over about 10 fields gets a bit ugly. The tab key becomes impracticleπand setting hotkeys for each field may not be practicle.ππThe program EXAMPLE.PAS is not an exageration, it is a SIMPLIFIED version ofπa dialog I am developing at work. Try getting to a field #54 via tabs!ππTLinked_Dialog solves the problem by having the Dialog jump between linksπyou define. Cursor keys are used to select the link direction, though 2 spareπlinks are defined for object future use or for object use.ππ Example of a linking: 11π 21 22π 31ππ Object 21 would want links defined for 11 ( DLink_Up ), 22 ( DLink_Right ),π and 31 ( DLink_Down ).ππ Once the links are defined, HandleEvent switches the focus according to theπ cursor keys.πππINITIALIZATION:ππTDialog is initialized exactly the same as TDialog. ( Refer to the Turbo Visionπmanual for details. )ππTLinked_Dialog.Init calls TDialog.Init and the initialized a collection ofπlinks to track item linking.ππUSAGE:ππOnce TLinked_Dialog is initialized, you insert items into the TLinked_Dialogπjust as you would a normal dialog.ππAfter the items are inserted, you set up links.ππ***** NOTE: Do not set up links for an item before it is inserted! *****ππLinks are created by calling TLinked_Dialog.Set_Link withπ Item to set link for : PViewπ Direction of link : Integerπ Use the constants:π DLink_Up, Dlink_Down, DLink_Right,π DLink_Left, DLink_Spare1, Dlink_Spare2π Pointer to linked item : PointerππAll links are 1 way. If you wish Button55 <--> Button56, you must defineπtwo links, Button55 right to Button56 and Button56 left to Button55. This isπbecause multiple items may be linked to the same item, which would make findingπthe reverse link impossible.ππYou can select another object via a link by calling TLinked_Dialog.Select_Linkπwith the link direction. The currently selected object's link will be tracedπto the next object ( If possible ).ππExample:ππ Var TR : TRect ;π TP : TPoint ;π TLD : TLinked_Dialog ;π Butt1 : TPushButton ;π Box1 : TNum_Box ;π Box2 : TNum_Box ;π Box3 : TNum_Box ;π Box4 : TNum_Box ;ππ Beginπ TR.Assign( 10 , 1 , 70 , 10 );π TLD.Init( TR ,'Test Linked Dialog');πππ (* Set up a button and insert it *)ππ TR.Assign( 5 , 3 , 15 , 5 );π Butt1.Init(TR,'~P~ush',cmOk,bfDefault));π TLD.Insert( Butt1 );ππ (* Set up box1 and insert it *)π TP.Y := 8 ;π TP.X := 3 ;ππ Box1.Init( TP , 3 , 2 , FALSE , 1 );π TLD.Insert( Box1 );ππ (* Set up box2 and insert it *)π TP.X := TP.X + 10 ;ππ Box2.Init( TP , 3 , 2 , FALSE , 1 );π TLD.Insert( Box2 );ππ TP.Y := 9 ;π TP.X := 3 ;ππ (* Set up box3 and insert it *)ππ Box3.Init( TP , 3 , 2 , FALSE , 1 );π TLD.Insert( Box3 );ππ TP.X := TP.X + 10 ;ππ (* Set up box and insert it *)ππ Box4.Init( TP , 3 , 2 , FALSE , 1 );π TLD.Insert( Box4 );ππ (* Boxes at [1] [2] *)π (* [3] [4] *)ππ (* Link Box1 -> Box2 *)π TDL.Set_Link( @BOX1 , DLink_Right , @BOX2 );ππ (* Link Box1 <- Box2 *)π TDL.Set_Link( @BOX2 , DLink_Left , @BOX1 );ππ (* Link Box3 -> Box4 *)π TDL.Set_Link( @BOX3 , DLink_Right , @BOX4 );ππ (* Link Box3 <- Box4 *)π TDL.Set_Link( @BOX4 , DLink_Left , @BOX3 );ππ (* Link Box1 -> Box3 *)π TDL.Set_Link( @BOX1 , DLink_Down , @BOX3 );ππ (* Link Box1 <- Box3 *)π TDL.Set_Link( @BOX3 , DLink_Up , @BOX1 );ππ (* Link Box2 -> Box4 *)π TDL.Set_Link( @BOX2 , DLink_Down , @BOX4 );ππ (* Link Box2 <- Box4 *)π TDL.Set_Link( @BOX4 , DLink_Up , @BOX2 );ππEnd;πππ}ππ{ Note: Tab Size = 4 }ππ(* Set conditions to allow for "Extended" type *)π{$N+,E+}ππ(**************************************************************************)π(* *)π(* Library of objects for Turbo Vision V1.00 *)π(* *)π(* By: Devin Cook *)π(* copyright (c) 1990 MSD *)π(* Public Domain Object library *)π(* *)π(* Object: TDateView *)π(* Same as TClockView, except displays the date *)π(* *)π(* Object: TPushButton *)π(* Same as TButton, except button "Show" press by keyboard *)π(* *)π(* Object: TNum_Box *)π(* An editable number only entry box - configurable *)π(* *)π(* Object: TLinked_Dialog *)π(* A normal dialog which handles cursor links to other *)π(* items *)π(* *)π(* Func: FormatDate *)π(* Formats a date into a string *)π(* *)π(**************************************************************************)ππ{$F+,O+,S-,D+}ππInterfaceππUses Crt, Dos, Objects, Views, Dialogs, Drivers;ππ(* Constents for Linked_Dialog *)ππConst DLink_Left = 1 ;π DLink_Right = 2 ;π DLink_Up = 3 ;π DLink_Down = 4 ;π DLink_Spare1 = 5 ;π DLink_Spare2 = 6 ;ππTypeππ(**************************************************************************)π(* *)π(* Object: TDateView *)π(* *)π(* Desc: TDateView is a static text object of the date, in a formated *)π(* string, usually placed on the status or menu lines. *)π(* *)π(* Format: Sun Dec 16, 1990 *)π(* *)π(* This format can be altered by changing Function FormatDate. *)π(* *)π(* Init: Initialization is done by supply a TRect to the INIT method. *)π(* *)π(* Note: The UPDATE method checks to see if the Day-of-Week value still *)π(* matches the system Day-of-Week, and updates it's view if they *)π(* don't match. An occasional call to TDateView.UPDATE will keep *)π(* your date indicator up to date. *)π(* *)π(**************************************************************************)ππ PDateView = ^TDateView;π TDateView = Object(TView)π DateStr: string[19];π Last_DOW: Word;π Constructor Init(var Bounds: TRect);π Procedure Draw; virtual;π Procedure Update; virtual;π End;ππ(**************************************************************************)π(* *)π(* Object: TPushButton *)π(* *)π(* Desc: TPushButton is a TButton except that it indicates being *)π(* pressed from the keyboard. *)π(* *)π(* Note: You may wish to adjust with the delay values in the *)π(* TPushButton.Press method to suit your taste. *)π(* *)π(* See TButton for method descriptions. *)π(* *)π(**************************************************************************)ππ PPushButton = ^TPushButton;π TPushButton = Object(Tbutton)π Procedure Press ; Virtual ;π End;ππ(**************************************************************************)π(* *)π(* Object: TNum_Box *)π(* *)π(* Desc: TInt_Box is a number only input box with an adjustable number *)π(* of digits before and after the decimal point. *)π(* *)π(* It can be flagged not to accept negative numbers if desired. *)π(* *)π(* Init: Initialization is done by providing your desired configuration *)π(* to TNum_Box.Init. *)π(* *)π(* TNum_Box.Init( *)π(* Loc - TPoint with location for num *)π(* MaxWh - Integer with #digits before the decimal *)π(* point *)π(* MaxDs - Integer with #digits after the decimal *)π(* point *)π(* NegOk - Boolean. True if neg values allowed *)π(* Deflt - Extended floating point with default value *)π(* ) *)π(* *)π(* Box width = MaxWh + *)π(* MaxDs + 1 ( if MaxDs > 0 ) + *)π(* 1 if Negok *)π(* *)π(* To read the value back, simply access the Curr_Val variable for the *)π(* TNum_Box. It is an extended floating point varaible, so you should *)π(* convert it to the desired precision. *)π(* *)π(* Note: A call to TNum_Box.Update_Val "Locks" the edited number into *)π(* the curr_val field, loading the default value if no number has *)π(* been entered. *)π(* *)π(**************************************************************************)ππ PNum_Box = ^TNum_Box;π TNum_Box = Object ( TView )π Max_Whole : Integer ;π Max_Decs : Integer ;π Max_Len : Integer ;π Neg_Ok : Boolean ;π Default_val : Extended ;π Num_Str : String[24] ;π Curr_Val : Extended ;π Dec_Pos : Integer ;π First_Char : Boolean ;ππ Constructor Init( Loc : TPoint ;π MaxWh : Integer ;π MaxDs : Integer ;π NegOk : Boolean ;π Dflt : Extended );π Procedure Draw; Virtual;π Procedure HandleEvent( Var Event:TEvent ); Virtual;π Procedure SetState( AState:Word; Enable:Boolean);π Virtual;π Procedure Add_Digit( Charcode : Char ); Virtual;π Procedure Do_Edit( Keycode : Word ); Virtual;π Procedure Update_Value;π End;ππ(* Record used by TLinked_Dialog *)ππ DLink_Record = Recordπ Item : Pointer ;π Left_Link : Pointer ;π Right_Link : Pointer ;π Up_Link : Pointer ;π Down_Link : Pointer ;π Spare1_Link : Pointer ;π Spare2_Link : Pointer ;π End;ππ(* Object for TLinked_Dialog's collection *)ππ PLink_Item = ^TLink_Item ;π TLink_Item = Objectπ Item : Pointer ;π Pointers : Array[1..6] of Pointer ;π Constructor Init( Link_Rec : DLink_Record );π Procedure Add_Link( Link_Direc : Integer ;π Link : Pointer );π End;ππ(* TLinked_Dialog's collection of links *)ππ PLinked_List = ^TLinked_List ;π TLinked_List = Object( TCollection )π Function Search( key : Pointer ) : Integer ;π End;ππ(**************************************************************************)π(* *)π(* Object: TLinked_Dialog *)π(* *)π(* Desc: TLinked_Dialog is a variation of a standard dialog which *)π(* allows for improved cursor movement between items. *)π(* *)π(* You can define which objects to "Link" to on the right, left, *)π(* above and below. These objects are focused by use of the *)π(* cursor keys. *)π(* *)π(* Two spare links are defined for item use ( such as switching *)π(* to a certain box once a button is pressed. ) *)π(* *)π(* Init: Initialization is identical to TDialog's init. Refer to the *)π(* Turbo Vision manual for details. *)π(* *)π(* Inserting an item is identical to a normal TDialog.Insert. When an *)π(* item is inserted into a TLinked_Dialog, a record is created for *)π(* tracking links. *)π(* *)π(* Defining a Link *)π(* *)π(* Once you have inserted all items into your dialog, links are created *)π(* to other items using TLinked_Dialog.Setlink. *)π(* *)π(* TLinked_Dialog.Setlink( *)π(* P - PView or descendant. *)π(* This is a pointer to the item you wish to add *)π(* the link to. *)π(* Link_Direc - Integer with link direction. *)π(* This should be one of the following constants: *)π(* DLink_Up : Up *)π(* DLink_Down : Down *)π(* DLink_Right : Right *)π(* DLink_Left : Left *)π(* DLink_Spare1 : Spare 1 *)π(* DLink_Spare2 : Spare 2 *)π(* Link - A pointer to the item you want to link to *)π(* ) *)π(* *)π(* Accesing a link *)π(* *)π(* Items within a dialog can switch to a linked item by calling: *)π(* *)π(* TLinked_Dialog.Select_link( *)π(* Direc - Integer with link direction. *)π(* ) *)π(* *)π(**************************************************************************)ππ PLinked_Dialog = ^TLinked_Dialog ;π TLinked_Dialog = Object( TDialog )π Link_List : TLinked_List ;π Constructor Init(var Bounds: TRect;π ATitle: TTitleStr);π Procedure Insert(P: PView); Virtual;π Procedure Set_Link( P: PView ;π Link_Direc : Integer ;π Link : Pointer );π Procedure HandleEvent( Var Event : TEvent );π Virtual;π Procedure Select_Link( Direc : Integer );π End;πππ(**************************************************************************)π(* *)π(* Function: FormatDate *)π(* *)π(* Desc: The format date function used by TDateView, made public for *)π(* other possible uses. *)π(* *)π(**************************************************************************)ππFunction FormatDate( Year , Month , Day , DOW : Word ): String;ππImplementationππ(**************************************************************************)π(* *)π(* Object: TDateView *)π(* *)π(**************************************************************************)ππConstructor TDateView.Init(var Bounds: TRect);πBeginπ TView.Init(Bounds);π DateStr := '';π LAST_DOW := 8 ; (* Force an update! *)πEnd;πππ(* Draw the TDateView object *)ππProcedure TDateView.Draw;πVarπ B: TDrawBuffer;π C: Byte;πBeginπ C := GetColor(2);π MoveChar(B, ' ', C, Size.X);π MoveStr(B, DateStr, C);π WriteLine(0, 0, Size.X, 1, B);πEnd;ππ(* Verify the TDateView object is up to date *)π(* Redisplaying it if it needs updating *)ππProcedure TDateView.Update;πVar Year, Month, Day, DOW : word;πBeginπ GetDate( Year , Month , Day , Dow );π If (DOW <> LAST_DOW) thenπ Beginπ DateStr := FormatDate( Year , Month , Day , DOW );π DrawView;π LAST_DOW := DOW ;π End;πEnd;ππ(**************************************************************************)π(* *)π(* Object: TPushButton *)π(* *)π(**************************************************************************)ππProcedure TPushButton.Press;πBeginπ DrawState(TRUE); (* Draw Button "Pressed" *)π Delay(150);π DrawState(FALSE); (* Draw Button "Released" *)π Delay(50);π TButton.Press;πEnd;ππ(**************************************************************************)π(* *)π(* Object: TNum_Box *)π(* *)π(**************************************************************************)ππConstructor TNum_Box.Init( Loc : TPoint ; MaxWh, MaxDs : Integer ;π NegOk : Boolean ; Dflt : Extended );πVar R : TRect ;π X : Integer ;π Wrk_Str : String ;ππBeginππ Wrk_Str := '' ;π If ( NegOk ) thenπ Wrk_Str := ' ' ;π For X := 1 to MaxWh doπ Wrk_Str := Wrk_Str + ' ' ;ππ If ( MaxDs > 0 ) thenπ Beginπ Wrk_Str := Wrk_Str + '.';π For X := 1 to MaxDs doπ Wrk_Str := Wrk_Str + ' ' ;π End;π R.Assign( Loc.X , Loc.Y , Loc.X + Length( Wrk_Str ) , Loc.Y + 1 );π TView.Init( R ) ;ππ Num_Str := Wrk_Str ;ππ Neg_Ok := NegOk ;π Max_Whole := MaxWh ;π Max_Decs := MaxDs ;ππ Max_Len := Length( Num_Str );ππ Options := Options OR ofSelectable ;ππ Default_Val := Dflt ;π Curr_Val := Dflt ;π Dec_Pos := Pos( '.' , Num_Str );ππ If ( Dec_Pos < 1 ) thenπ Dec_Pos := Max_Len + 1 ;πππ Cursor.X := Dec_Pos - 2;ππ First_Char := True ;π ShowCursor;πEnd;ππ(* Draw the TNum_Box on the view. *)π(* Color depends on the state of *)π(* the object. *)ππProcedure TNum_Box.Draw;πVar Buff : TDrawBuffer ;π Colr : Word;πBeginπ Colr := GetColor(19);π If GetState(sfFocused) thenπ If First_Char thenπ Colr := GetColor(20)π elseπ Colr := GetColor(22);ππ MoveChar( Buff,' ',Colr, Size.X);π MoveStr( Buff,Num_Str,0);π Writeline(0,0,Size.X,1,Buff);ππEnd;ππ(* Updated SetState to watch for changes in the *)π(* selected and focused flags. *)ππProcedure TNum_Box.SetState(AState: Word; Enable: Boolean);πBeginπ TView.SetState(AState, Enable);π If ( AState = sfFocused ) thenπ Draw ;π If ( AState = sfFocused ) And ( Enable ) thenπ First_Char := TRUE ;πEnd;ππ(* HandleEvent, routing keystrokes *)ππProcedure TNum_Box.HandleEvent( Var Event : TEvent );πVar NextCmd: TEvent;π test:PEvent;πBeginπ TView.HandleEvent( Event );π If Event.What = evKeydown thenπ Beginπ Case ( Event.Charcode ) ofπ #00 : Beginπ End;π #08 : Beginπ Do_Edit( Event.keyCode );π ClearEvent( Event );π End;π #13 : Beginπ ClearEvent( Event );π Update_Value ;π End;π '0'..'9': Beginπ Add_Digit( Event.Charcode );π ClearEvent( Event );π End;π '.','-': Beginπ Add_Digit( Event.Charcode );π ClearEvent( Event );π End;π End;π End;πEnd;ππ(* Perform normal charector addition to the number string *)ππProcedure TNum_Box.Add_Digit( Charcode : Char );πVar X : Integer ;π First_Dig : Integer ;πBeginππ If ( First_Char ) thenπ Beginπ For X := 1 to Length( Num_Str ) doπ If (Num_Str[X]<>'.') thenπ Num_Str[X]:=' ';ππ First_Char := False ;π Cursor.X := Dec_Pos - 2;π ShowCursor;π End;ππ If Neg_Ok thenπ First_Dig := 2π elseπ First_Dig := 1;ππ If ( Cursor.X < Dec_Pos ) thenπ Case ( Charcode ) ofπ '0'..'9' : If Not( Num_Str[ First_Dig ] IN ['0'..'9']) thenπ Beginπ For X := 1 to Cursor.X doπ Num_Str[X] := Num_Str[X+1] ;π Num_Str[ Cursor.X + 1 ] := Charcode ;π End;π '-' : Beginπ If (Neg_Ok) thenπ Beginπ if (Num_Str[ Cursor.X + 1 ] = ' ') thenπ Num_Str[ Cursor.X + 1 ] := '-'π End;π End;π '.' : Beginπ If (Max_Decs>0) and ( Cursor.X < Dec_Pos ) thenπ Beginπ Cursor.X := Dec_Pos ;π ShowCursor;π End;π End;π Endπ elseπ Case ( Charcode ) ofπ '0'..'9' : Beginπ If ( Cursor.X < ( Max_Len - 1 )) thenπ Beginπ Num_Str[Cursor.X+1] := Charcode ;π Inc( Cursor.X );π ShowCursor;π Endπ elseπ if Num_Str[Cursor.X+1] = ' ' thenπ Num_Str[Cursor.X+1] := Charcode ;π End;π End;ππ Draw;πEnd;ππ(* Perform any editing on the number string *)π(* ( Only the <Backspace> key is currently *)π(* supported ). *)ππProcedure TNum_Box.Do_Edit( Keycode : Word );πVar X : Integer ;πBeginπ First_Char := False ;π If ( Dec_Pos = 0 ) or ( Cursor.X < Dec_Pos ) thenπ Beginπ If (Keycode = kbBack) thenπ Beginπ For X := Cursor.X+1 downto 2 doπ Num_Str[X] := Num_Str[X-1] ;π Num_Str[ 1 ] := ' ' ;π End;π Endπ elseπ Beginπ If (Keycode = kbBack) thenπ Beginπ If Num_Str[Cursor.X+1] = ' ' thenπ Beginπ Dec( Cursor.X );π Num_Str[Cursor.X+1] := ' ';π Endπ elseπ Num_Str[Cursor.X+1] := ' ';ππ If Num_Str[ Cursor.X ] = '.' thenπ Cursor.X := Cursor.X - 2 ;π ShowCursor;π End;π End;ππ Draw;πEnd;ππ(* "Lock" the number string value in the box. *)π(* Use the default value if no number is present. *)ππProcedure TNum_Box.Update_Value;πVar Code : Integer ;π Work_str: String[24];πBeginπ Work_Str := Num_Str ;π While (( Length( Work_Str )>0 ) and ( Work_Str[Length( Work_Str )] IN ['.',' '])) doπ Work_Str := Copy( Work_Str , 1 , length( Work_Str ) -1 );ππ Code := 0 ;ππ If ( Work_Str = '' ) thenπ Curr_Val := Default_Valπ elseπ Val( Work_Str, Curr_Val , Code );π Str( Curr_Val:Max_Len:Max_Decs , Num_Str );ππ Cursor.X := Max_Len - 1 ;π First_Char := True ;π Draw;πEnd;ππ(**************************************************************************)π(* *)π(* Object: TLink_Item *)π(* *)π(* Used by TLinked_Dialog to track links *)π(* *)π(**************************************************************************)ππConstructor TLink_Item.Init( Link_Rec : DLink_Record );πBeginπ Item := Link_Rec.Item ;π With Link_Rec doπ Beginπ Pointers[DLink_Left] := Left_Link;π Pointers[DLink_Right] := Right_Link;π Pointers[DLink_Up] := Up_Link;π Pointers[DLink_Down] := Down_Link;π Pointers[DLink_Spare1] := Spare1_Link;π Pointers[DLink_Spare2] := Spare2_Link;π End;πEnd;ππProcedure TLink_Item.Add_Link( Link_Direc : Integer ; Link : Pointer );πBeginπ Pointers[ Link_Direc ] := Link ;πEnd;ππ(**************************************************************************)π(* *)π(* Object: TLink_List *)π(* *)π(* Used by TLinked_Dialog to track links *)π(* *)π(**************************************************************************)ππFunction TLinked_List.Search( Key : Pointer ) : Integer ;πVar X : Integer ;π Found : Boolean ;π Linked_Item : PLink_Item ;πBeginπ Search := -1 ;π Found := False ;π X := 0 ;π While ( X < Count ) AND ( NOT FOUND ) doπ Beginπ Linked_Item := at( X );π Found := Linked_Item^.Item = Key ;π X := X + 1 ;π End;ππ If ( Found ) thenπ Search := X - 1 ;πEnd;ππ(**************************************************************************)π(* *)π(* Object: TLinked_Dialog *)π(* *)π(**************************************************************************)ππConstructor TLinked_Dialog.Init(var Bounds: TRect; ATitle: TTitleStr);πBeginπ TDialog.Init( Bounds , ATitle );π Link_List.Init(10, 5);πEnd;ππProcedure TLinked_Dialog.Insert(P: PView);πVar Linked_Item : PLink_Item ;π Blank_Rec : DLink_Record ;πBeginπ With Blank_Rec doπ Beginπ Item := P ;π Left_Link := Nil ;π Right_Link := Nil ;π Up_Link := Nil ;π Down_Link := Nil ;π Spare1_Link := Nil ;π Spare2_Link := Nil ;π End;π Linked_Item := New( PLink_Item , Init( Blank_Rec ) );π TDialog.Insert( P );π Link_List.Insert( Linked_Item );πEnd;ππProcedure TLinked_Dialog.Set_Link(P:PView;Link_Direc:Integer;Link:Pointer);πVar Linked_Item : PLink_Item ;π X : Integer ;πBeginπ X := Link_List.Search( P );π If ( X < 0 ) thenπ Exit ;π Linked_Item := Link_List.at( X );π Linked_Item^.Pointers[ Link_Direc ] := Link ;πEnd;ππProcedure TLinked_Dialog.Select_Link( Direc : Integer );πVar X : Integer ;π LL_Item : PLink_Item ;π Item : PView ;πBeginπ X := Link_List.Search( Current );π LL_Item := Link_List.at(X);π Item := LL_Item^.Pointers[ Direc ];π If ( Item <> Nil ) thenπ Item^.Select ;πEnd;ππProcedure TLinked_Dialog.HandleEvent( Var Event : TEvent );πVar X : Integer ;π LL_Item : PLink_Item ;π Item : PView ;πBeginπ TDialog.HandleEvent( Event );ππ If ( Event.What = evKeydown ) thenπ Case Event.keycode ofπ kbUp : Beginπ Select_Link( DLink_Up );π ClearEvent( Event );π End;π kbDown : Beginπ Select_Link( DLink_Down );π ClearEvent( Event );π End;π kbRight : Beginπ Select_Link( DLink_Right );π ClearEvent( Event );π End;π kbLeft : Beginπ Select_Link( DLink_Left );π ClearEvent( Event );π End;π End;πEnd;ππ(**************************************************************************)π(* *)π(* Function: FormatDate *)π(* *)π(**************************************************************************)ππFunction FormatDate( Year , Month , Day , DOW : Word ): String;πConstπ DAYS : Array[0..6] of String = ( 'Sun','Mon','Tue','Wed','Thu','Fri','Sat');π MONTHS : Array[1..12] of String = ( 'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');πVar Work1,Work2 : String[4] ;πBeginπ Str( Day,Work1 );π If ( Day < 10 ) thenπ Work1 := '0' + Work1 ;π Str( Year,Work2 );π FormatDate := DAYS[DOW]+' '+MONTHS[Month]+' '+Work1+', '+Work2;πEnd;ππBeginπend.ππ{----------------------- DEMO CODE --------------------- }ππProgram Example;ππUses Crt,App, Objects, Views, Dialogs, Drivers, Misc;ππTypeπ PMyApp = ^TMyApp ;π TMyApp = Object( TApplication )π Constructor Init;π End;ππVarπ MyApp : TMyApp ;π Dialog : PLinked_Dialog;ππ Screen_Array : Array[1..70] of TNum_Box;ππProcedure Build_Links;πVar P : TPoint ;π X,Y : Integer ;π N : Integer ;πBeginππ For N := 1 to 50 doπ Beginπ P.Y := ( N - 1 ) DIV 10 + 8 ;π P.X := ( N - 1 ) MOD 10 * 4 + 20 ;ππ Screen_Array[N].Init( P , 3 , 0 , FALSE , N );π Screen_Array[N].Update_Value;π End;ππ For N := 1 to 8 doπ Beginπ P.Y := ( N - 1 ) Div 3 * 2 + 8 ;π P.X := ( N - 1 ) Mod 3 * 4 + 60 ;π If ( N > 6 ) thenπ P.X := P.X + 4 ;π Screen_Array[N+50].Init( P , 3 , 0 , FALSE , N+50 );π Screen_Array[N+50].Update_Value;π End;ππ P.Y := 6 ;ππ(* Initialize 5 floating point boxes *)ππ For N := 1 to 5 doπ Beginπ P.X := ( N * 12 ) ;π Screen_Array[N+58].Init( P , 4 , 2 , True , N+58 );π End;ππ(* Insert all boxes before setting links! *)ππ For N := 1 to 63 doπ Dialog^.Insert( @Screen_Array[N] );ππ For N := 1 to 50 doπ Beginπ if ( N MOD 10 ) <> 1 thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Left ,@Screen_array[N-1]);π if ( N MOD 10 ) <> 0 thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Right,@Screen_array[N+1]);π if ( N > 10 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Up ,@Screen_array[N-10])π elseπ Dialog^.Set_Link(@Screen_array[N],DLink_Up ,@Screen_array[59]);ππ if ( N <41 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Down ,@Screen_array[N+10]);ππ if ( N=10 ) or ( N=20 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Right,@Screen_array[51]);ππ if ( N=30 ) or ( N=40 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Right,@Screen_array[54]);π End;ππ Dialog^.Set_Link(@Screen_array[50],DLink_Right,@Screen_array[57]);ππ Dialog^.Set_Link(@Screen_array[51],DLink_Left ,@Screen_array[10]);π Dialog^.Set_Link(@Screen_array[51],DLink_Right,@Screen_array[52]);π Dialog^.Set_Link(@Screen_array[51],DLink_Down ,@Screen_array[54]);ππ Dialog^.Set_Link(@Screen_array[52],DLink_Left ,@Screen_array[51]);π Dialog^.Set_Link(@Screen_array[52],DLink_Right,@Screen_array[53]);π Dialog^.Set_Link(@Screen_array[52],DLink_Down ,@Screen_array[55]);ππ Dialog^.Set_Link(@Screen_array[53],DLink_Left ,@Screen_array[52]);π Dialog^.Set_Link(@Screen_array[53],DLink_Down ,@Screen_array[56]);ππ Dialog^.Set_Link(@Screen_array[54],DLink_Left ,@Screen_array[30]);π Dialog^.Set_Link(@Screen_array[54],DLink_Right,@Screen_array[55]);π Dialog^.Set_Link(@Screen_array[54],DLink_Down ,@Screen_array[57]);π Dialog^.Set_Link(@Screen_array[54],DLink_Up ,@Screen_array[51]);ππ Dialog^.Set_Link(@Screen_array[55],DLink_Left ,@Screen_array[54]);π Dialog^.Set_Link(@Screen_array[55],DLink_Right,@Screen_array[56]);π Dialog^.Set_Link(@Screen_array[55],DLink_Down ,@Screen_array[57]);π Dialog^.Set_Link(@Screen_array[55],DLink_Up ,@Screen_array[52]);ππ Dialog^.Set_Link(@Screen_array[56],DLink_Left ,@Screen_array[55]);π Dialog^.Set_Link(@Screen_array[56],DLink_Down ,@Screen_array[58]);π Dialog^.Set_Link(@Screen_array[56],DLink_Up ,@Screen_array[53]);ππ Dialog^.Set_Link(@Screen_array[57],DLink_Left ,@Screen_array[50]);π Dialog^.Set_Link(@Screen_array[57],DLink_Right,@Screen_array[58]);π Dialog^.Set_Link(@Screen_array[57],DLink_Up ,@Screen_array[55]);ππ Dialog^.Set_Link(@Screen_array[58],DLink_Left ,@Screen_array[57]);π Dialog^.Set_Link(@Screen_array[58],DLink_Up ,@Screen_array[56]);ππ For N := 59 to 63 doπ Beginπ if ( N > 59 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Left ,@Screen_array[N-1]);π if ( N < 63 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Right,@Screen_array[N+1]);π Dialog^.Set_Link(@Screen_array[N],DLink_Down,@Screen_array[1]);π End;πEnd;ππProcedure Do_Dialog;πVar R : TRect ;π TP : TPoint ;π N : Integer ;π Button : PButton ;πBeginππ R.Assign( 0 , 10 , 80 , 24 );π Dialog := New( PLinked_Dialog , Init( R , 'Linked Dialog Example' ));π Dialog^.SetState(sfShadow,False );ππ Build_Links;ππ R.Assign( 5 , 8 , 15 , 10 );π Button := New(PPushButton,Init(R,'~P~ush',cmOk,bfDefault));π Dialog^.Insert( Button );ππ R.Assign( 5 , 11 , 15 , 13 );π Button := New(PPushButton,Init(R,'~E~xit',cmQuit,bfDefault));π Dialog^.Insert( Button );ππ Dialog^.Set_Link(Button,DLink_Right,@Screen_array[1]);ππ MyApp.Insert( Dialog );ππEnd;πππConstructor TMyApp.Init;πBeginπ TApplication.Init ;π Do_Dialog;πEnd;ππBeginπ ClrScr;π MyApp.Init ;π MyApp.Run ;π MyApp.Done ;πEnd.
